home *** CD-ROM | disk | FTP | other *** search
(*************************************************** Ant Movie Catalog importation script www.antp.be/software/moviecatalog/ [Infos] Authors=ScorEpioN Title=DVDPost.be Description=Louez vos DVD en ligne sur www.dvdpost.be Site=http://www.dvdpost.be Language=FR Version=02 du 23/05/2005 Requires=3.5 Comments=Ce script nΘcessite le fichier ScorEpioNCommonScript.pas|.==.| : ' ( ( ( ( /\ | "==()))))): ⌐ ScorEpioN ⌐| ( ( ( ( \_/ License=This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. | GetInfo=1 [Options] Mise α jour=1|1|0=Oui|1=Non Type de Lancement=0|0|0=Demande le titre avant de lancer le script|1=Ne demande pas le titre avant de lancer le script|2=Cherche le meilleur rΘsultat sans confirmation|3=Lancement automatique sur l'adresse web Casse Choisie=3|3|0=Titre et Nom en minuscule|1=Titre et Nom en majuscule|2=PremiΦre lettre en majuscule|3=PremiΦre lettre de chaque mot en majuscule Titre en double=0|0|0=Garde les titres originaux et traduits mΩme identiques|1=Garde les titres originaux si identiques|2=Garde les titres traduits si identiques Recherche sur le titre=0|0|0=Traduit|1=Original Note=0|0|0=Moyenne DVDPost & Internautes|1=DVDPost|2=Internautes Fichier de log=1|1|0=Oui|1=Non ***************************************************) program DVDPost_FR; uses ScorEpioNCommonScript; const VersionScript = '02 du 23/05/2005'; NomScript = 'DVDPOST'; urlDomain = 'dvdpost.be'; urlBase = 'http://www.dvdpost.be/'; urlSearch = urlBase+'advanced_search_result2.php?keywords='; urlImage = 'http://images.dvdpost.be//dvd/'; timeSleep = 500; var MovieName, Address : string; i, premiereExecution : Integer; listeResultat: TStringList; //------------------------------------------------------------------------------ // RECUPERE LES RESULTATS DVDPost.be //------------------------------------------------------------------------------ procedure recherche(title : String); var Line, titre, adresse : String; StartPos, EndPos : Integer; begin Line := GetPage(urlSearch+UrlEncode(title)); if pos('<b>DVD</b><br><table width="100%"></table>', Line) = 0 then begin listeResultat := TStringList.Create; StartPos := pos('<b>DVD</b>', Line); delete(Line, 1, StartPos+length('<b>DVD</b>')-1); // RΘcupΘre les rΘsultats StartPos := pos('<a href="', Line); delete(Line, 1, StartPos-1); repeat {*********************** Boucle DEBUT ***********************} StartPos := pos('<a href="', Line); delete(Line, 1, StartPos-1); {*********************** Boucle DEBUT ***********************} adresse := urlBase+findInfo('<a href="', '"', Line,'0'); titre := findInfo('<u>', '</u>', Line,'0'); // Ajoute les films listeResultat.Add(titre+'|'+adresse); {*********************** Boucle FIN ***********************} delete(Line, 1, length('<a href="')); EndPos := pos('<b>Acteurs</b>', Line); StartPos := pos('<a href="', Line); {*********************** Boucle FIN ***********************} until (StartPos > EndPos); // CrΘation de la liste de rΘsultats afficheResultat(title); end else begin SetField(fieldChecked, ''); exit; end; end; //------------------------------------------------------------------------------ // CREATION DE LA LISTE DE RESULTAT //------------------------------------------------------------------------------ procedure afficheResultat(title : String); var StartPos: Integer; couple, titre, adresse : String; begin if (GetOption('Type de Lancement') = 0) or (GetOption('Type de Lancement') = 1) then begin PickTreeClear; PickTreeAdd('Films trouvΘs pour ' + title + ' :', ''); for i:=0 to listeResultat.Count-1 do begin couple := listeResultat.GetString(i); titre := copy(couple,0,pos('|',couple)-1); delete(couple, 1, length(titre)+1); HTMLDecode(titre); adresse := copy(couple,0,length(couple)); delete(couple, 1, length(adresse)+1); PickTreeAdd(titre, adresse); end; if listeResultat.Count = 1 then begin recupInfo(adresse); exit; end; begin if PickTreeExec(Address)=true then begin recupInfo(Address); end; end; end else if (GetOption('Type de Lancement') = 2) then begin if listeResultat.Count = 1 then begin couple := listeResultat.GetString(0); titre := copy(couple,0,pos('|',couple)-1); delete(couple, 1, length(titre)+1); HTMLDecode(titre); adresse := copy(couple,0,length(couple)); delete(couple, 1, length(adresse)+1); recupInfo(adresse); exit; end else begin trouveTitle(title); end; end; end; //------------------------------------------------------------------------------ // RECUPERE LES INFOS //------------------------------------------------------------------------------ procedure recupInfo(Adresse : String); var Value, Value2, Line: String; StartPos : Integer; begin // Pour le mode Batch if (GetOption('Fichier de log') = 0) then beforeUpdate(); // Importe la page Sleep(timeSleep); Line := GetPage(Adresse); // Jaquette DVD if CanSetPicture then MonGetPicture(urlImage+findInfo(urlImage, '"', Line,'0')); // Titre Traduit if CanSetField(fieldTranslatedTitle) or CanSetField(fieldYear) then begin Value := findInfo('#75757A;font-weight:bold">', '</TD>', Line,'0'); Value2 := findInfo('( ', ' )', Value,'0'); Value := StringReplace(Value, '( '+Value2+' )', ''); MonSetField(fieldTranslatedTitle, formatTitre(Trim(Value),GetOption('Casse Choisie'))); MonSetField(fieldYear, Value2); end; {// Titre Original if CanSetField(fieldOriginalTitle) then MonSetField(fieldOriginalTitle, formatTitre(findInfo('Titre original</b></td>', '</td>', Line,'0'),GetOption('Casse Choisie')));} // Genre if CanSetField(fieldCategory) then begin Value := findInfo(';color:gray">', '</TD>', Line,'-1'); Value := StringReplace(Value, ' | ', ','); Value := StringReplace(Value, '/', ' '); Value := StringReplace(Value, #13#10, ', '); Value := StringReplace(Value, ' ,', ','); Value := StringReplace(Value, ',,', ','); Value := StringReplace(Value, ', ', ''); MonSetField(fieldCategory, formatTitre(deleteEnd(Value,', '),GetOption('Casse Choisie'))); end; // DurΘe if CanSetField(fieldLength) then MonSetField(fieldLength, findInfo('<B>DurΘe:', '</TD>', Line,'0')); // Acteurs if CanSetField(fieldActors) then begin Value := findInfo('<B>Acteurs:', '</td>', Line,'0'); Value := StringReplace(Value, ' , ', ','); Value := StringReplace(Value, ' ,', '.'); MonSetField(fieldActors, formatTitre(Value,GetOption('Casse Choisie'))); end; // RΘalisateur if CanSetField(fieldDirector) then begin Value := findInfo('<B>RΘalisateur:', '</td>', Line,'0'); Value := StringReplace(Value, ' , ', ','); Value := StringReplace(Value, ' ,', '.'); MonSetField(fieldDirector, formatTitre(Value,GetOption('Casse Choisie'))); end; // ScΘnario if CanSetField(fieldDescription) then MonSetField(fieldDescription, findInfo('<td class="boxText" align="left">', '</TR>', Line,'0')); // Studio if CanSetField(fieldProducer) then MonSetField(fieldProducer, findInfo('<B>Studio:', '</TD>', Line,'0')); // Note if CanSetField(fieldRating) then begin Value := FormatFloat(FloatToStr(StrToFloat(findInfo('starbar/stars_1_', '.gif', Line,'0'))/5)); // Note DVDPost Value2 := FormatFloat(FloatToStr(StrToFloat(findInfo('Cotation moyenne: <b>', '</b>', Line,'0'))*2)); // Note Internautes if (GetOption('Note') = 0) then begin if Value2 <> '0.0' then MonSetField(fieldRating, FloatToStr((StrToFloat(Value)+StrToFloat(Value2))/2)) else MonSetField(fieldRating, Value); end else if (GetOption('Note') = 1) then begin MonSetField(fieldRating, Value); end else if (GetOption('Note') = 2) then begin MonSetField(fieldRating, Value2); end; end; // Adresse Web if CanSetField(fieldURL) then MonSetField(fieldURL, Adresse); // Public if CanSetField(fieldComments) then begin Value := findInfo('<b>Public:', '</TD>', Line,'1'); Value := findInfo('.be//', '.gif', Value,'0'); if Value <> '' then Value := 'Public : '+AnsiUpperCase(Value); MonSetField(fieldComments, Value); end; // Pour le mode Batch if (GetOption('Fichier de log') = 0) then afterUpdate(); // Affichage des titres si original et traduit identique titreDouble(GetOption('Titre en double')); end; //------------------------------------------------------------------------------ // SUPPRIME LES ACCENTS //------------------------------------------------------------------------------ function supprimeAccents(NomFilm : String) : String; begin // les accents NomFilm := supprimeLesAccents(NomFilm); // Pour n'avoir que le titre delete(NomFilm, pos(' - ',NomFilm), length(NomFilm)); if (pos(', ',NomFilm) > 0) then delete(NomFilm, 1, pos(', ',NomFilm)+1); if (pos('(',NomFilm) > 0) then delete(NomFilm, pos('(',NomFilm), length(NomFilm)); if (pos(':',NomFilm) > 0) then delete(NomFilm, pos(':',NomFilm), length(NomFilm)); result := trim(NomFilm); end; //------------------------------------------------------------------------------ // COMPARE LE TITRE PASSE ET LE TITRE TROUVE //------------------------------------------------------------------------------ function compareTitle(titleAllo, title : String) : String; begin title := supprimeAccents(trim(AnsiLowerCase(title))); titleAllo := supprimeAccents(trim(AnsiLowerCase(titleAllo))); if (title = titleAllo) then begin result := 'OK'; end else begin result := 'KO'; end; end; //------------------------------------------------------------------------------ // TROUVE LE BON TITRE SI LE PREMIER N'EST PAS LE BON //------------------------------------------------------------------------------ procedure trouveTitle(title : String); var oK, couple, titre, adresse : String; begin for i:=0 to listeResultat.Count-1 do begin couple := listeResultat.GetString(i); titre := copy(couple,0,pos('|',couple)-1); delete(couple, 1, length(titre)+1); HTMLDecode(titre); adresse := copy(couple,0,length(couple)); delete(couple, 1, length(adresse)+1); oK := compareTitle(title,titre); if oK = 'OK' then begin recupInfo(adresse); exit; end; end; listeResultat.Free; end; //------------------------------------------------------------------------------ // PROGRAMME PRINCIPAL //------------------------------------------------------------------------------ begin if CheckVersion(3,5,0) then begin if GetOption('Mise α jour') = 0 then begin execMenuMAJ(VersionScript,NomScript); exit; end; MovieName := recupTitreRecherche(GetOption('Recherche sur le titre')); Sleep(timeSleep); if (GetOption('Fichier de log') = 0) and (premiereExecution = 0) then begin batch(NomScript); AddToLog('Les films ayant ΘtΘ mis α jour sont maintenant cochΘs'); end; if (GetOption('Type de Lancement') = 0) then begin if Input(NomScript+' by ScorEpioN', 'Entrez le titre du film :', MovieName) then begin if Pos(urlDomain, MovieName) > 0 then begin recupInfo(MovieName); end else recherche(MovieName); end; end else if (GetOption('Type de Lancement') = 3) then begin if (premiereExecution = 0) then begin premiereExecution := -1; if (ShowConfirmation('Vous allez executer le script sans confirmation, cliquer sur ''''OUI'''' pour continuer') = False) then exit; end; MovieName := GetField(fieldURL); if Pos(urlDomain, MovieName) > 0 then recupInfo(MovieName); end else begin if (premiereExecution = 0) then begin premiereExecution := -1; if (ShowConfirmation('Vous allez executer le script sans confirmation, cliquer sur ''''OUI'''' pour continuer') = True) then begin recherche(MovieName); end else exit; end else begin recherche(MovieName); end; end; end else ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)'); end. 
